unit MMDBEngine;

interface
Uses Classes, Forms, StdCtrls, Dialogs,  SysUtils, Messages, Data.DB,
     Datasnap.DBClient, Data.Win.ADODB, StrUtils, Variants;

const
_BLK = 0;
_CRA = 1;
_CMS = 2;
_DEC = 3;
_DWG = 4;
_FIX = 5;
_FMEA = 6;
_FORM = 7;
_GPS = 8;
_KIT = 9;
_MPS = 10;
_PPS = 11;
_PRO  = 12;
_QAP = 13;
_QSP = 14;
_REP = 15;
_SP = 16;
_STP = 17;
_TBL = 18;
_TEC = 19;
_TESTER = 20 ;
_TF = 21;
_WS = 22;

type TDocType = (eBLK, eCRA, eCMS, eDEC, eDWG, eFIX, eFMEA, eFORM, eGPS, eKIT, eMPS,
                 ePPS, ePRO , eQAP, eQSP, eREP, eSP, eSTP, eTBL,
                 eTEC, eTESTER, eTF, eWS);
type TDCDocument = record
  public
    PathName: string;
    FileName: string;
end;

procedure GetDocPaths(dt: tDocType; var ds: TClientDataSet; Root: string; var memo: TMemo);
procedure BuildDocList(const PathName, FileName: string; Rec: TSearchRec;
                       var ds: TClientDataSet; var memo: TMemo);
function IncludeTrBackslash(Path: string): string;
function ExtractDocType(dcDoc: TDocType): string;
function CheckValidFixExtension(ext: string):boolean;
procedure ExtractDocFromPath(var ds: TClientDataSet; var memo: TMemo; dt: TDocType);
procedure MatchDocToPath(var db: TClientDataSet; var ds: TClientDataSet;
                         var memo: TMemo; dt: TDocType);
procedure CreateLogFile(var db: TClientDataSet; var ds: TClientDataSet);
procedure ShowMatchStatus(i: integer; Cnt: Integer);

implementation
uses MMDBMain, Parser;
(***************************************************************************
GetDocPaths(): Run recursive query on parent and sub-directories for the
               doc type parameter. Populate the referenced TStringList  with
               the results.
*******************************************************************************)
procedure GetDocPaths(dt: TDocType; var ds: TClientDataSet; Root: string; var memo: TMemo);
var
  dcDoc: TDCDocument;
  Rec: TSearchRec;
begin
  memo.Lines.Add('Searching doc control for  '+ ExtractDocType(dt) + ' documents & building paths...');    //add a blank line.
  case dt of
   eBLK:
    begin
      dcDoc.PathName := copy(Root, 0, Length(Root)-4)+'\KITS\DCLIB'; //Naming convention: nnnnnnr (multiple ext, CAD/SolidWorks etc.)
      dcDoc.FileName := '*.dwg';  //all BLK dwgs are of type dwg.
    end;
   eCRA:
    begin
      dcDoc.PathName := Root+'\CRA'; //naming convention: CRAnnnr.doc/x
      dcDoc.FileName := 'CRA*.doc';  //all CRA of type doc/x.
    end;
   eCMS:
    begin
      dcDoc.PathName := Root+'\CMS'; //naming convention: CMSnnnnr.doc/x
      dcDoc.FileName := 'CMS*.doc';  //all CMS of type doc/x.
    end;
   eDEC:
    begin
      dcDoc.PathName := Root+'\DEC'; //Naming convention: DECnnnnr.doc/x
      dcDoc.FileName := 'DEC*.doc';  //all DEC are of type doc/x.
    end;
  eDWG:
    begin
      dcDoc.PathName := Root+'\DRAW'; //Naming convention: nnnnnnr (multiple ext, CAD/SolidWorks etc.)
      dcDoc.FileName := '*.*';  //No indicator at first of doc, must list all
    end;
  eFMEA:
    begin
      dcDoc.PathName := Root+'\FMEA'; //Naming convention: FMEAnnnnr.doc/xls
      dcDoc.FileName := 'FMEA*';  //all FMEA docs start with 'FMEA'
    end;
   eFIX:
    begin
      dcDoc.PathName := Root+'\FIXTURE'; //Naming convention: Fnnnn (multiple rev formats)
      //dcDoc.PathName := 'C:\Temp\doc\Fixture';    //TEST 4/10/13
      dcDoc.FileName := 'F*';  //multiple document extentions
    end;
  eFORM:
    begin
      dcDoc.PathName := Root+'\FORMS'; //Naming convention: Fn-nnnr  (Different formats exist, many exts)
      dcDoc.FileName := 'F*';  //all FORM docs start with 'F'
    end;
  eGPS:
    begin
      dcDoc.PathName := Root+'\GPS'; //naming convention: Gnnn-nnnr(r).doc/x  (may have 2 letter rev)
      dcDoc.FileName := 'G*.doc';  //all GPS docs start with 'G'and have .doc/x extension
    end;
  eKIT:
    begin
      dcDoc.PathName := Root;  //search all kits paths off of the Kits root.
      dcDoc.FileName := 'K*.dwg';    //all kit dwgs start with K, and are .dwg format.
    end;
  eMPS:
    begin
      dcDoc.PathName := Root+'\MPS';  //naming convention: Mnnn-nnnr(r).doc/x  (may have 2 letter rev)
      dcDoc.FileName := 'M*.doc';  //all MPS docs start with 'M' and have .doc/x ext
    end;
  ePPS:
    begin
      dcDoc.PathName := Root+'\PPS'; //Naming convention: Pnnnnnnnnn.doc/x
      dcDoc.FileName := 'P*.doc';  //all PPS docs start with 'P' and are .doc/x or .dwg
    end;
  ePRO:
    begin
      dcDoc.PathName := Root+'\PRO';   //Naming convention: Pnn-nnnnr.doc/x
      dcDoc.FileName := 'P*.doc';  //PRO docs start with 'P' and are .doc/x (does not include possible apendices/attachments)
    end;
  eQAP:
    begin
      dcDoc.PathName := Root+'\QAP';  //naming convention: Qnnn-nnnr(r).doc/x  (may have 2 letter rev)
      dcDoc.FileName := 'Q*.doc';  //all QAP docs start with  'Q' and have .doc/x ext
    end;
  eQSP:
    begin
      dcDoc.PathName := Root+'\QSP'; //Naming Convention: QSPnnnnr(r).doc/x  (may have 2 letter rev)
      dcDoc.FileName := 'Q*.doc';  //all QSP docs start with  'Q' and have .doc/x ext
    end;
  eREP:
    begin
      dcDoc.PathName := Root+'\PRO';  //Naming Convention: Rnn-nnnn(F/I)nnr.doc/x
      dcDoc.FileName := 'R*.doc';  //REP docs start with 'R' and are .doc/x (does not include possible apendices/attachments)
    end;
  eSP:
    begin
      dcDoc.PathName := Root+'\SP'; //Naming convention: SPnnnn(ttt)r   various ext
      dcDoc.FileName := 'SP*';  //all SP docs start with 'SP'- various extensions
    end;
   {eSTD:
    begin
      dcDoc.PathName := Root+'\STD'; //Multiple naming coventions.
      dcDoc.FileName := '*.pdf';  //all STDs of type .pdf
    end; }
  eSTP:
    begin
      dcDoc.PathName := Root+'\STP'; //Naming convention: STPnnnnr.doc/x
      dcDoc.FileName := 'STP*.doc';  //all STP docs start with 'STP' and have .doc/x ext
    end;
  eTBL:
    begin
      dcDoc.PathName := Root+'\TBL'; //Naming convention: Tnnnr  (multiple extensions)
      dcDoc.FileName := 'T*';  //all TBL docs start with 'T'- various extensions
    end;
  eTEC:
    begin
      dcDoc.PathName := Root+'\TECHFILE'; //Naming convention: TECnnnn
      dcDoc.FileName := 'TEC*.doc';  //all TEC contain a .doc/x file.
    end;
  eTESTER:
    begin
      dcDoc.PathName := Root+'\TESTER'; //Naming convention: Multiple.
      dcDoc.FileName := 'T0*.*';  //all T's have a zero after the t at this point. Multiple file extensions.
    end;
 eTF:
   begin
      dcDoc.PathName := Root+'\TESTER'; //Naming convention: Multiple.
      dcDoc.FileName := 'TF*.*';  //Multiple file extensions.
    end;
  eWS:
    begin
      dcDoc.PathName := Root+'\WS'; //Naming convention: WSnnnnnn-nnr
      dcDoc.FileName := 'WS*.*';  //Multiple extensions.
    end;
  end;
  BuildDocList(dcDoc.PathName,dcDoc.FileName, Rec, ds, memo);
end;

(******************************************************************************
BuildDocList: Creates TList of docs, by doc type, from doc control, including
              path information. This list will be compared with the master
              Oracle doc list, and existing docs will be added to the user
              grid with a hyperlinked path.
*******************************************************************************)
procedure BuildDocList(const PathName, FileName: string; Rec: TSearchRec; var ds: TClientDataSet; var memo: TMemo);
var
 Path: string;
begin
  Path := IncludeTrBackslash(PathName);
 {Search for files in specified parent directory first}
  if FindFirst(Path + FileName, faAnyFile - faDirectory, Rec) = 0 then
  try
    repeat
      if Rec.Name[1] <> '~' then     //do not add placeholder files to list
         begin
           ds.AppendRecord([Path + Rec.Name, '','']);
           if ds.RecordCount mod 50 = 0 then
             memo.Lines[memo.Lines.count-1] := memo.Lines[memo.Lines.count-1] + '.';
         end;
    until FindNext(Rec) <> 0;
  finally
    FindClose(Rec);
  end;
  {Now search sub-directories, recursively call BuildDocList to find files in subs}
  if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then //directory attrib now enabled.
  try
    repeat
      if (Rec.Attr and faDirectory > 0) and (Rec.Name <> '.') and
        (Rec.Name <> '..') then
        BuildDocList(Path + Rec.Name, FileName, Rec, ds, memo);
        Application.ProcessMessages;
    until FindNext(Rec) <> 0;
  finally
    FindClose(Rec);
  end;
end;

(***************************************************************************
IncludeTrBackslash(): Simple utility function to add a trailing backslash to
                      a file path string.
*******************************************************************************)
function IncludeTrBackslash(Path: string): string; //add trailing backslash
begin
  if Copy(Path, Length(Path), 1) = '\' then
    Result := Path
  else
    Result := Path + '\';
end;

(***************************************************************************
UpdateDCStatus(): Provides text string to calling function to update the status
                  bar based on the type of doc being processed.
*******************************************************************************)
function ExtractDocType(dcDoc: TDocType): string;
begin
  case dcDoc of
    eBLK: result := 'BLK';
    eCRA: result := 'CRA';
    eCMS: result := 'CMS';
    eDEC: result := 'DEC';
    eDWG: result := 'DWG';
    eFMEA: result := 'FMEA';
    eFIX: result := 'F';
    eFORM: result := 'FRM';
    eKIT: result := 'DK';
    eGPS: result  := 'GPS';
    eMPS: result := 'MPS';
    ePPS: result := 'PPS';
    ePRO: result := 'PRO';
    eQAP: result := 'QAP';
    eQSP: result := 'QSP';
    eREP: result := 'RPT';
    eSP: result := 'SP';
    //eSTD: result := 'STD';
    eSTP: result := 'STP';
    eTBL: result  := 'TBL';
    eTEC: result := 'TEC';
    eTESTER: result := 'T';
    eTF: result := 'TF';
    eWS: result := 'WS';
  end;
end;

(***************************************************************************
ExtractDocFromPath(): Extracts the document file name, minus the extension,
                      from the complete path. Must deal with the Merit
                      document naming conventions to ensure that the name
                      is extracted properly.
*******************************************************************************)
procedure ExtractDocFromPath(var ds: TClientDataSet; var memo: TMemo; dt: TDocType);
var
  dsStr, tmpStr, fixStr, extStr: string;
  i, j, idx, extPos: Integer;
begin
  //Create a list with just files names (from doc control, but maintain the
  //same index as the full list (with path name included)
  memo.Lines.Add('Extracting document names from paths ... ');    //add a blank line.
  i := 0;
  ds.First;   //move to first record in data set
  while not ds.Eof do
    begin
      dsStr := ds.FieldByName('fFullPath').AsString;
      idx := Length(dsStr)-1;
      while (dsStr[idx] <> '.') and (idx > 0)do  //find the position of the file extension.
        dec(idx);
      extPos := idx;    //save the position in the string of the file extension.
      extStr := copy(dsStr, idx+1, Length(dsStr)-1);  //save the file extension.
      for j := 0 to Length(extStr) do          //convert extension to upper case
        extStr[j] := upcase(extStr[j]);
      if dt = eFIX then
        if CheckValidFixExtension(extStr) = false then
        begin
          ds.Delete;  //delete the record, automatically moves to next record.
          Continue;  //move to next iteration
        end;
      while (dsStr[idx] <> '\') and (idx > 0)do  //now extract the file name.
        dec(idx);
  //Now must process the string to strip off the doc prefix (e.g. 'M' for MPS). Some docs
  //such as FMEA are unique and must be handled differently.
      //if dt = eREP then
       // memo.Lines.Add('Doc List val: '+DocList[i]);
      case dt of
        eFMEA: tmpStr := copy(dsStr,idx+5,(extPos-idx-5));
        eFORM, eGPS, eMPS, ePPS, ePRO, eQAP, eTBL: tmpStr := copy(dsStr,idx+2,(extPos-idx-2));
        eQSP, eSTP, eCRA, eCMS, eDEC, eTEC: tmpStr := copy(dsStr,idx+4,(extPos-idx-4));
        eSP, eWS: tmpStr := copy(dsStr,idx+3,(extPos-idx-3));   //strip off first 2 chars
        eDWG: tmpStr := copy(dsStr,idx+1,6);   //only want 6 first 6 digits in kit name
        eREP: tmpStr := copy(dsStr, idx+2, 8);   //copy 1st 8 chars in format (reports only)
        eBLK, eKIT: tmpStr := copy(dsStr, idx+1, (extPos-idx-1)); //leave everything in the file name except '\'.
        eTESTER:   //tester is unique case due to inconsistent file naming
          begin
            tmpStr := copy(dsStr,idx+2,(extPos-idx-1));   //strip off the T
            fixStr:= '';  //reset
            for j := 1 to Length(tmpStr)-1 do
              if tmpStr[j] <> '_' then
                fixStr := fixStr + tmpStr[j];
            tmpStr := fixStr;
           // if i mod 100 = 0 then
           //   memo.Lines.Add(tmpStr);
          end;
        eTF:
          begin
            tmpStr := copy(dsStr,idx+3,(extPos-idx-2));   //strip off the TF
            fixStr:= '';  //reset
            for j := 1 to Length(tmpStr)-1 do
              if tmpStr[j] <> '_' then
                fixStr := fixStr + tmpStr[j];
            tmpStr := fixStr;
            //if i mod 20 = 0 then
            //  memo.Lines.Add(tmpStr);
          end;
        eFIX:
          begin
            tmpStr := copy(dsStr,idx+2,(extPos-idx-2));   //strip off the F
            fixStr := '';   //clear string.
            for j := 1 to Length(tmpStr)-1 do
              if tmpStr[j] <> '_' then
                fixStr := fixStr + tmpStr[j];
            tmpStr := fixStr;
          end;
       end;     //end case dt of
  //At this point, for many docs,  hyphen chars "-" need to be converted to
  //periods "." to maket the doc controlfile name compatible with the Oracle
  //file name. (Brilliant, Merit......)

      case dt of
      eGPS, eMPS, eQAP:
         begin
            for j := 0 to Length(tmpStr)-1 do
              if tmpStr[j] = '-' then
                  tmpStr[j] := '.';
         end;
      eFORM:
        begin
          for j := 0 to 3 do         //only change dash to period with in 1st 3 chars, as
            if tmpStr[j] = '-' then  //dashes are used elsewhere in these doc titles.
              tmpStr[j]:= '.';
        end;
      eSP:
        begin
          fixStr := copy(tmpStr,0,4) + '.' + copy(tmpStr,5,4);
          tmpStr := fixStr;
        end;
      end;
      if tmpStr <> '' then
        begin
          (**********Added 6/6/2013 since Doc Control decided to add underscores
           to all of these file names before the rev. Need to remove underscore
           to allow the file to match the database value*************************)
          if (dt = eCRA) or
             (dt = eCMS) or
             (dt = eDEC) or
             (dt = eFMEA) or
             (dt = eGPS) or
             (dt = eMPS) or
             (dt = ePPS) or
             (dt = ePPS) or
             (dt = eQAP) or
             (dt = eQSP) or
             (dt = eSP) or
             (dt = eSTP) or
             (dt = eTBL) or
             (dt = eWS) then
            begin
              fixStr := '';
              for j := 1 to Length(tmpStr) do
                if tmpStr[j] <> '_' then
                  fixStr := fixStr + tmpStr[j];
              tmpStr := fixStr;
            end;
        (*************END OF UPDATE********************************************)
          ds.Edit;
          ds['fFileName'] := tmpStr;  //add the completed file name to the list
          ds['fExtension'] := ExtStr;    //add the completed extension to the list.
          ds.Next;          //move to next record
        end
        else
          begin
            ds.Delete;  //delete current record. Automatically moves to next record
          end;
       if ds.RecNo mod 100 = 0 then
         //memo.Lines[memo.Lines.count-1] := memo.Lines[memo.Lines.count-1] + '.';
         memo.Lines.Add(tmpStr +' ' +ExtStr);
    end;
    Application.ProcessMessages;
end;

(***************************************************************************
MatchDocToPath(): Move through the current doc list in the client data set, and
                find file path to the doc num in doc control. Delete docs that
                don't have a match from the client data set/grid.
*******************************************************************************)
procedure MatchDocToPath(var db: TClientDataSet; var ds: TClientDataSet;
                         var memo: TMemo; dt: TDocType);
var
  ShortList: TStringList;
  ExtList: TStringList;
  i: Integer;
  Str: string;
  j: Integer;
  LoopIt, Iteration: Integer;
  opts: TLocateOptions;
begin
try
  //First, get the document name (minus extension) from the full path.
  //NOTE: Shortlist doc name will doc rev appended to doc name.
  ExtractDocFromPath(ds, memo, dt);
  //now match each document in the list to the title from the Oracle query, and
  //copy into the client data set.
  //db.First;  //Make sure we are at the first record.
  //memo.Lines.Add('DataSet Record Count = ' + IntToStr(db.RecordCount));

  memo.Lines.Add('dsFullPath count: '+IntToStr(ds.RecordCount));
  memo.Lines.Add('Matching document names from Oracle with document paths ... ');
  //db.Locate('dbcDocType',ExtractDocType(dt),[]);   //seek to the 1st record matching the current doc type.
  //ShowMessage('db count before filter: '+IntToStr(db.RecordCount));
  db.Filter := 'dbcDocType = '+ QuotedStr(ExtractDocType(dt));
  db.Filtered := True;
  //ShowMessage('db count after filter: '+IntToStr(db.RecordCount));
  Iteration := 0;
  try
    //if dt = eKIT then
    //  CreateLogFile(db, ds);
    db.First;
    ds.First;
    case dt of
      eCRA, eCMS, eDEC, eFMEA, eFORM, eGPS, eKIT, eMPS, ePPS, ePRO, eQAP, eQSP, eSP, eSTP, eTBL, eTEC:
      //if (dt <> eREP) and (dt<> eDWG) and (dt<> eBLK) and (dt<> eFIX)and (dt<> eTESTER)and (dt<> eSTD)then
        begin
          opts := [loCaseInsensitive];
          while not db.Eof do
            begin
              if ds.Locate('fFileName', db.FieldByName('dbcDocNumRev').AsString,
                          opts) then
                begin
                  db.Edit;   //put into edit mode.
                  db['dbcDocPath'] := ds['fFullPath'];
                  db['dbcShortcut'] := ds['fExtension'];
                  ds.Delete;   //remove line now- won't need again.
                  //break;
                end;
                if db.FieldByName('dbcDocPath').AsString = '' then
                   db.Delete     //will automatically move to next record if we delete.
                     else
                       db.Next;
                inc(Iteration);
                if Iteration mod 100 = 0 then
                  ShowMatchStatus(Iteration, db.RecordCount);
            end;     //end while
          end;    //end case 1
        eREP, eDWG, eBLK, eFIX, eTESTER, eTF:      //need separate handler, as there are too many rev combinations.
          begin
            opts := [loPartialKey, loCaseInsensitive];
            while not ds.Eof do
              begin
                if db.Locate('dbcDocNumRev', ds.FieldByName('fFileName').AsString,
                            opts) then
                  begin
                    db.Edit;   //put into edit mode.
                    db['dbcDocPath'] := ds['fFullPath'];
                    db['dbcShortcut'] := ds['fExtension'];
                    ds.Delete;   //remove line now- won't need again.
                  end
                  else
                    ds.Next;
                inc(Iteration);
                if Iteration mod 100 = 0 then
                  ShowMatchStatus(Iteration, db.RecordCount);
              end;  //end while
            db.First;
            while not db.Eof do
              if db.FieldByName('dbcDocPath').AsString = '' then
                   db.Delete  //get rid of all of records where no match was found.
                   else
                     db.Next;
             MMDBMainFrm.lblDataSetCnt.Caption := 'DataSet Count: '+IntToStr(db.RecordCount);
          end;
         eWS:
           begin
             while not db.Eof do
               begin
                 Str := db.FieldByName('dbcDocNumRev').AsString;
                 if StartsText('WS-', Str) then      //some WS start WS-, others just WS (brilliant!)
                    Str := copy(Str, 4, Length(Str)-3)
                      else
                        Str := copy(Str,3,Length(Str)-2);
                 if ds.Locate('fFileName', VarArrayOf([Str]),[loCaseInsensitive]) then
                  begin
                    db.Edit;   //put into edit mode.
                    db['dbcDocPath'] := ds['fFullPath'];
                    db['dbcShortcut'] := ds['fExtension'];
                    ds.Delete;   //remove line now- won't need again.
                    //break;
                  end;
                  if db.FieldByName('dbcDocPath').AsString = '' then
                       db.Delete     //will automatically move to next record if we delete.
                         else
                           db.Next;
                  inc(Iteration);
                  if Iteration mod 100 = 0 then
                    ShowMatchStatus(Iteration, db.RecordCount);
               end;
           end;
        end;  //end case
  except
    ShowMessage('Unknow exception ocurred.');
  end;
  ds.IndexName := 'DEFAULT_ORDER';   //switch back to default
  ds.EmptyDataSet;    //clear out all previous data.
except
  ShowMessage('Error occured in MatchDocToPath function.');
end;
end;

(***************************************************************************
CheckValidFixExtension(): Due to the variety of fixture extensions, must
                          validate the fixture extension to prevent list errors.
******************************************************************************)
function CheckValidFixExtension(ext: string):boolean;
var
  tmp: string;
begin
  tmp := ext[1]+ext[2]+ext[3];
  if(tmp = 'IPT') or
    (tmp = 'IAM') or
    (tmp = 'IDW') or
    (tmp = 'IPN') or
    (tmp = 'DWG') or
    (tmp = 'PDF') or
    (tmp = 'SLD') then result := True
    else result := False;
end;

(***************************************************************************
CreateLogFile(): Utility procedure to create a log of the data in ds and db
                 before the search for file/Oracle results is executed.
******************************************************************************)
procedure CreateLogFile(var db: TClientDataSet; var ds: TClientDataSet);
var
  tmpList: TStringList;
begin
  try
    db.First;
    ds.First;
    tmpList := TStringList.Create;
    tmpList.Add('ORACLE Contents- dbcDocNum:');
    while not db.Eof do
      begin
        tmpList.Add(db.FieldByName('dbcDocNumRev').AsString);
        db.Next;
      end;
    tmpList.SaveToFile('c:\temp\KdbData.txt');
    tmpList.Clear;
    tmpList.Add('DocCTRL Contents- dsFileName');
    while not ds.Eof do
      begin
        TmpList.Add(ds.FieldByName('fFileName').AsString);
        ds.Next;
      end;
    tmpList.SaveToFile('c:\temp\KdsData2.txt');
    tmpList.Free;
  except
    ShowMessage('Unable to create log files.');
  end;
end;

procedure ShowMatchStatus(i: integer; Cnt: Integer);
begin
  MMDBMainFrm.lblLoopIt.Caption := IntToStr(i);
  MMDBMainFrm.lblDataSetCnt.Caption := 'DataSet Count: '+IntToStr(Cnt);
  Application.ProcessMessages;
end;

end.
